Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue31/webcomm/WEBTRANS.PAS

Pascal/Delphi Source File | 1998-01-14 | 22.6 KB | 670 lines

unit webtrans;

// TCustomTransactionQueuer and derivatives
// for managing transaction processing in
// Web commerce applications
//
// (c) 1997 South Pacific Information Services Ltd
//  http://www.spis.co.nz      [e-mail]
//
// Permission is granted for the adaptation and use
// of this code provided this message is maintained
// and this source code is not onsold without
// explicit permission from SPIS Ltd.

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;


type
 TTransactionStatus = ( tsInvalid, tsQueue, tsCancel, tsProcessing,
                        tsTimeOut, tsAccept, tsReject);

 TTransactionData =
  record
    TransactionID: string; { a unique identifier, e.g. surfer name, session ID }
    TransactionType: string;{ May be used, e.g. if doing authorisations (not confirmed sales)
                              with settlement happening LATER after shipping is confirmed }
    MerchantID: string;    { only needed if the back end is multi-merchant enabled }
    MerchantPassword: string; { as above, assuming the back end requires a password }
    Comment: string;       { available with some services -- appears on form }
    Clerk: string;         { ditto }
    CardNumber: string;    { no spaces or punctuation }
    ExpiryMonth: string;   { 01..12 }
    ExpiryYear: string;    { 98, 99, 2000, 2001... }
    TransactionAmount: string; { total amount to be authorised or transferred }
    Age: TDatetime;        { Time when transaction was first queued, set by Queue, not caller }
    TransactionStatus: TTransactionStatus; { set by Queuer or returned from Processor }
  end;
  // Notes about TTransactionData:
  // 1) these components handle queuing/processing, NOT
  //    validation! Therefore, they assume the information provided
  //    via the above structure has been checked beforehand, and contains no
  //    punctuation, spaces or other spurious information which may be rejected by
  //    the processing service
  // 2) Not all the above fields may be used by each implementation -- the
  //    assumption is that the important fields will be used and preserved
  //    by whatever file/memory queueing schema is adopted in each case

type
  // Abstract class which implements the most common logic:
  TCustomTransactionQueuer = class(TComponent)
  private
    fTransactionData: TTransactionData;
    fQueueByFile: Boolean;       // File/Memory require implementation in derived classes
    fEncryptionPassword: string; // if encryption is implemented
  protected
    function LoadTransaction: Boolean;

    // derived classes must implement these methods to support File, Memory or both:
    // The functions should return False if the Transaction is not present
    // The 'Save' procedures should recognise a tsCancel status and
    // handle it accordingly -- in most cases just by deleting the entry...
    procedure SaveTransactionToFile; virtual; abstract;
    function LoadTransactionFromFile: Boolean; virtual; abstract;
    procedure DeleteTransactionFromFile; virtual; abstract;
    procedure SaveTransactionToMemory; virtual; abstract;
    function LoadTransactionFromMemory: Boolean; virtual; abstract;
    procedure DeleteTransactionFromMemory; virtual; abstract;

  public
    procedure QueueTransaction;
    procedure CheckTransaction;
    procedure CancelTransaction;
    procedure DeleteTransaction;
    procedure SaveTransaction; // only publically used for Processor components
    function GetStatusMessage: String; virtual;
  published
    property TransactionData: TTransactionData read fTransactionData write fTransactionData;
    property StatusMessage:string read GetStatusMessage;
  end;


  // Base class for file-based queuing
  TCustomFileTransactionQueuer = class(TCustomTransactionQueuer)
  private
     fQueueDirectory: string;
     procedure SetQueueDirectory(const value: string);
  protected
    constructor Create(AOwner: TComponent); override;


    // here's an implemented set of core file-based methods:
    function LoadTransactionFromFile: Boolean; override;
    procedure SaveTransactionToFile; override;
    procedure DeleteTransactionFromFile; override;

    // these ones MAY need overriding in derived classes
    function GetTransactionFileName: string; virtual;
    function GetLoadFileName: string; virtual;
    function GetSaveFileName: string; virtual;
    function GetProcessedFileName: string; virtual;

    // these two MUST be implemented in derived classes:
    procedure ReadDataFromBuffer(const buffer: string); virtual; abstract;
    procedure WriteDataToBuffer(var buffer: string); virtual; abstract;

    // this one should be implemented ONLY if separate "process result" files
    // are returned (e.g. by ICVerify)
    function LoadProcessedResult(const filename: string): Boolean; virtual; abstract;

  published
    property QueueDirectory: string read fQueueDirectory write SetQueueDirectory;
  end;

  // example derived class for exceptionally simple file-based queuing
  TSimpleFileTransactionQueuer = class(TCustomFileTransactionQueuer)
  private
  protected
     // custom routines overridden for this implementation:
    function GetTransactionFileName: string; override;
    procedure ReadDataFromBuffer(const buffer: string);override;
    procedure WriteDataToBuffer(var buffer: string); override;
  public
  published
  end;

  // example derived class for processing TSimpleFileTransactionQueuer queues
  TSimpleFileTransactionProcessor = class(TSimpleFileTransactionQueuer)
  private
  protected
  public
     function GetNextTransaction: Boolean;
  published
  end;


  // derived class for ICVerify's file-based queuing
  TICVerifyTransactionQueuer = class(TCustomFileTransactionQueuer)
  private
    fTransactionList: TStringList;
  protected
     // custom routines overridden for this class:
    procedure DeleteTransactionFromFile; override;
    function GetLoadFileName: string; override;
    function GetSaveFileName: string; override;
    function GetProcessedFileName: string; override;
    procedure ReadDataFromBuffer(const buffer: string);override;
    procedure WriteDataToBuffer(var buffer: string); override;
    function LoadProcessedResult(const filename: string): Boolean; override;

    // new routine:
    function GetFileNameForThisTransaction: string;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
  end;


procedure Register;

implementation

// ### TCustomTransactionQueuer component
//
// Abstract class at the heart of all that follows

const TransactionStatusMessages : array[TTransactionStatus] of string =
  ( 'Invalid',
    'Queued and awaiting processing',
    'Canceled',
    'Now processing',
    'Timed out',
    'Accepted',
    'Rejected');

procedure TCustomTransactionQueuer.QueueTransaction;
begin
   if not LoadTransaction then // isn't already there?
   with TransactionData do
   begin
      TransactionStatus := tsQueue;
      Age := now;
      SaveTransaction;
   end;
end;

// Note: before calling CheckTransaction, you MUST set all relevant
// fields, just as you would for a Queue. This is because if the Check
// doesn't find the transaction in the queue already, it re-establishes
// it, thus providing for a fail-safe recovery if, for example,
// the queuing has been cleared by a system failure or restart.

procedure TCustomTransactionQueuer.CheckTransaction;
begin
  QueueTransaction;  // check for existence, re-establish if not!
end;

procedure TCustomTransactionQueuer.CancelTransaction;
begin
   if LoadTransaction then // there?
   begin
     with TransactionData do
     begin
        if TransactionStatus = tsQueue then // still Queued ok
        begin
          TransactionStatus := tsCancel;
          DeleteTransaction; // if it fails, it Loads again in case status has changed
        end; { otherwise, caller must respond to actual status returned by original Load }
     end
   end else
     with TransactionData do TransactionStatus := tsInvalid;
end;

procedure TCustomTransactionQueuer.SaveTransaction;
begin
   if fQueueByFile then
      SaveTransactionToFile
   else
      SaveTransactionToMemory;
end;

function TCustomTransactionQueuer.LoadTransaction: Boolean;
begin
   if fQueueByFile then
      result := LoadTransactionFromFile
   else
      result := LoadTransactionFromMemory;
end;

procedure TCustomTransactionQueuer.DeleteTransaction;
begin
   if fQueueByFile then
      DeleteTransactionFromFile
   else
      DeleteTransactionFromMemory;
end;


function TCustomTransactionQueuer.GetStatusMessage: String;
begin // Only valid if accessed just after a Queue/Check/Cancel operation
 result := TransactionStatusMessages[TransactionData.TransactionStatus];
end;


// ### TCustomFileTransactionQueuer component
//
// This derived abtract class implements queuing by
// file without governing the format of the data
// within the file. Hence, a class derived from it can
// override two or three methods to implement specialised
// file formats/contents/encryption as required, which is
// what TICVTransactionQueuer does later on in this file.

constructor TCustomFileTransactionQueuer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fQueueByFile := True;
end;

procedure TCustomFileTransactionQueuer.SetQueueDirectory(const value: string);
begin
  if (value<>'') and (copy(value,Length(value),1)<>'\') then
     fQueueDirectory := value +'\'
  else
     fQueueDirectory := value;
end;

function TCustomFileTransactionQueuer.LoadTransactionFromFile: Boolean;
var transactionFileName: string;
    fs: TFileStream;
    buffer: string;
begin
  result := False;
  transactionFilename := GetProcessedFileName;
  if transactionFilename<>'' then
  begin // we have a spec which supports separate result files, AND we've found one
    result := LoadProcessedResult(transactionFilename);
    exit;
  end;

  transactionFilename := GetLoadFileName;
  if not FileExists(transactionFileName) then
    exit; { sorry, not there }
  fs := TFileStream.create(transactionFilename,fmOpenRead or fmShareDenyNone);
  try
    With TransactionData do Age := FileDateToDateTime(filegetdate(fs.handle));
    SetLength(buffer,fs.size);
    fs.read(buffer[1],fs.size);
  finally
    fs.free;
  end;
  ReadDataFromBuffer(buffer);
  result := True;
end;

procedure TCustomFileTransactionQueuer.DeleteTransactionFromFile;
var fn: string;
begin
  fn := GetLoadFilename; // if any
  if fn<>'' then
    DeleteFile(fn);
  fn := GetProcessedFilename; // if any
  if fn <>'' then
    DeleteFile(fn);
end;

procedure TCustomFileTransactionQueuer.SaveTransactionToFile;
var fs: TFileStream;
    buffer: string;
begin
  WriteDataToBuffer(buffer);
  try
    fs := TFileStream.create(GetSaveFilename,fmCreate or fmShareExclusive);
  except;
    with TransactionData do TransactionStatus := tsInvalid;
    exit;
  end;

  try
   fs.write(buffer[1],Length(buffer));
  finally
    fs.free;
  end;
end;

// dummy naming scheme, likely to be overridden/enhanced in derived components
function TCustomFileTransactionQueuer.GetTransactionFilename: string;
begin
  result := QueueDirectory+TransactionData.TransactionID;
end;

// for these ones, we'll assume a simple case where they are ALL the same file,
// and the contents tell the story...
function TCustomFileTransactionQueuer.GetLoadFilename: string;
begin
  result := GetTransactionFilename;
end;

function TCustomFileTransactionQueuer.GetSaveFilename: string;
begin
  result := GetTransactionFilename;
end;

function TCustomFileTransactionQueuer.GetProcessedFilename: string;
begin
  result := ''; // default spec is "don't use this"
end;

// ### TSimpleFileTransactionQueuer component
//
// This fully-implemented component, derived from
// TCustomFileTransactionQueuer, uses an extremely
// simple (and unencrypted) format containing only
// the essential transaction information in comma-delimited form

const SimpleFileTransactionExtension = '.trn';

function TSimpleFileTransactionQueuer.GetTransactionFilename: string;
begin
  result := inherited GetTransactionFilename + SimpleFileTransactionExtension;
end;

  // set buffer from the appropriate TransactionData fields
procedure TSimpleFileTransactionQueuer.WriteDataToBuffer(var buffer: string);
begin
  with TransactionData do
    buffer :=CardNumber+','+
           ExpiryYear+','+
           ExpiryMonth+','+
           TransactionAmount+','+
           '"'+StatusMessage+'"'; // which is based on the current status
end;

  // extract the appropriate TransactionData fields
procedure TSimpleFileTransactionQueuer.ReadDataFromBuffer(const buffer: string);
var status: TTransactionStatus;
begin
(* buffer is: CardNumber+','+
              ExpiryYear+','+
              ExpiryMonth+','+
              TransactionAmount+','+
              "StatusMessage";
*)
  with TStringList.Create do
  try
    CommaText := buffer; { easy way to break it out into a nice list }
    with transactionData do
    begin
      TransactionStatus := tsInvalid;
      if count < 5 then { bad data }
         exit;
      for status := low(TTransactionStatus) to high(TTransactionStatus) do
      begin
        if CompareText(Strings[4],TransactionStatusMessages[status])=0 then
        begin
          CardNumber := Strings[0];
          ExpiryYear := Strings[1];
          ExpiryMonth := Strings[2];
          TransactionAmount := Strings[3];
          TransactionStatus := status; { all set }
          exit;
        end;
      end;
    end;
  finally
    free;
  end;
end;

// ### TSimpleFileTransactionProcessor component
//
// This component is derived from TSimpleFileTransactionQueuer
// and handles the checking of the queue and loading of
// entries for actual processing, together with
// the status settings required.

// Only one additional function -- to retrieve the next
// unprocessed transaction (if any)

function TSimpleFileTransactionProcessor.GetNextTransaction;
var SearchRec: TSearchRec;
    FoundOne : Integer;
    dotPos: Integer;
    Searchfor: string;
begin
   result := False; { set to True if we find a new transaction }
   SearchFor :=QueueDirectory+'*'+SimpleFileTransactionExtension;
   FoundOne := FindFirst(SearchFor,faAnyFile,SearchRec);
   try
     while FoundOne=0 do
     begin
       with SearchRec, TransactionData do // a match if status is still "Queued"
       begin
          TransactionID :=ExtractFileName(name);
          dotPos :=pos('.',TransactionID);
          if dotPos> 0 then // should be, but let's keep it general
             TransactionID :=copy(TransactionID,1, dotPos-1);
          LoadTransactionFromFile; { get file contents }
          if TransactionStatus = tsQueue then // ok, ready to go
          begin // all set...
            result := True;
            exit;
          end; // otherwise ignore it, keep looking
       end;
       FoundOne := FindNext(SearchRec);
     end;
   finally
     SysUtils.FindClose(SearchRec);
   end;
end;



// ### TICVerifyTransactionQueuer component
//
// This derived component implements file-based queuing:
// a) Using ICVerify's file formats and filename management
// b) Recognising ICVerify's "simple mode" status responses
// -- as defined for the standalone Windows ICV application
// See Appendix B of the ICVerify manual for more information

// NB: For use with multiple simultaneous merchants, this direct
//     "by file" approach is not sufficient. Instead, you need to
//     buy the IC Verify SDK for $750. Among other things, the SDK
//     explains how to go beyond the regular one-merchant setup by
//     calling their DLL. You should do this from a standalone Processor
//     application which reads the queued files and calls ICV's DLL,
//     including appropriate Merchant information.
//     In all likelihood you'd find the SimpleFile components the
//     easiest route to manage interactions between the Webapp and
//     your Processor app -- this component is far more complex
//     than it needs to be because of the fairly specialised
//     queue/response filenames and formats which the standalone
//     ICV app uses.

// Also note:
//     This implementation assumes we're going to queue transactions
//     which represent IMMEDIATE sales. This is fine if online delivery
//     is guaranteed (e.g. for software or information). However, for
//     cases where a separate shipping step is required, it would be
//     better to book a sale (C4), then track the transaction so
//     that it can be later marked as "shipped" (C5).
//     Even in the immediate sale case a "settlement" step is required
//     which can be done (for all processed-but-unsettled transactions)
//     using the ICV software, or via a "ST" coded request (see Appx B).

const ICVFileStub='icver';
      ICVRequestExt='.req';
      ICVResponseExt='.ans';
      ICVTransactionListFile='transl.lst';

constructor TICVerifyTransactionQueuer.Create(aOwner: TComponent);
begin
  inherited Create(AOwner);
  fTransactionData.TransactionType := 'C1'; // "Immediate sale" -- see ICV manual appdx B
  fTransactionList := TStringList.create;
end;

destructor TICVerifyTransactionQueuer.Destroy;
begin
  fTransactionList.free;
  inherited Destroy;
end;

function TICVerifyTransactionQueuer.GetFileNameForThisTransaction: string;
begin
  result :=''; // failure
  with fTransactionList do
  begin
    clear;
    try
      if not FileExists(QueueDirectory+ICVTransactionListFile) then
        exit;  // this is just to prevent IDE break-on-exception scares
      LoadFromFile(QueueDirectory+ICVTransactionListFile)
    except on E:exception do exit;
    end;
    result := Values[TransactionData.TransactionID]; // e.g 12345=000
    if result<>'' then
      result:=QueueDirectory+ICVFileStub+result; // --> \path\icver000
  end;
end;


// seek existing "request" filename containing our transactionID
function TICVerifyTransactionQueuer.GetLoadFilename: string;
begin
  result := GetFileNameForThisTransaction;
  if result ='' then
    exit;
  result := result+ICVRequestExt;
  if not FileExists(result) then
    result := '';
end;

// seek existing "request" filename containing our transactionID
function TICVerifyTransactionQueuer.GetProcessedFilename: string;
begin
  result := GetFileNameForThisTransaction;
  if result ='' then
    exit;
  result := result+ICVResponseExt;
  if not FileExists(result) then
    result := '';
end;


// seek UNIQUE "request" filename -- we use a TransactionList
// which is saved to file each time, so that we can stop/start
// the Webapp without loss of this vital mapping information
function TICVerifyTransactionQueuer.GetSaveFilename: string;
var tcount, newcount: Integer;
    clashed: Boolean;
begin
  with fTransactionList do
  begin
    clear;
    try
      if FileExists(QueueDirectory+ICVTransactionListFile) then
        LoadFromFile(QueueDirectory+ICVTransactionListFile)
    except on E:exception do ;
    end;
    newcount :=0;
    repeat   // this logic could be made faster, but the search space is
      clashed := False; // usually only one or two transactions, so there's little point
      for tcount := 0 to pred(count) do
      begin
        result := Values[Names[tcount]]; // e.g 12345=000
        if StrToInt(result)=newcount then
        begin
          clashed := True;
          inc(newcount);
          break;
        end;
      end; // for
    until not clashed; // newcount is available when we exit
    result:=format('%3.3d',[newcount]); // 0 --> '000'
    Values[TransactionData.TransactionID] :=result;
    SaveToFile(QueueDirectory+ICVTransactionListFile);
    result := QueueDirectory+ICVFileStub+result+ICVRequestExt; // --> icver000.req
  end;
end;

procedure TICVerifyTransactionQueuer.DeleteTransactionFromFile;
var tcount: Integer;
begin
  inherited DeleteTransactionFromFile;
  // fTransactionList must be in memory and may have a record
  // we need to eliminate, so as to free up the filename space
  with fTransactionList do
  for tcount:=0 to pred(count) do
    if Names[tcount]=TransactionData.TransactionID then // yup
    begin
      delete(tcount);
      SaveToFile(QueueDirectory+ICVTransactionListFile);
      exit;
    end;
end;


function TICVerifyTransactionQueuer.LoadProcessedResult(const filename: string): Boolean;
var line: String;
begin
  result := False;
  if not FileExists(filename) then
    exit;
  with TStringList.Create do
  try
    try
      LoadFromFile(filename);
    except on E:exception do exit;
    end;
    line := Strings[pred(count)];
    result := True;
    fTransactionData.Age := FileDateToDatetime(FileAge(filename));
    if copy(line,1,1)='"' then //strip probable quotes
      line := copy(line,2,maxLongint);
    if copy(line,Length(line),1)='"' then
      line := copy(line,1,pred(Length(line)));
    // a "simple mode" response should start with Y or N, of the form:
    // YMN1234B1234567 -- MN then approval code, B then reference
    with TransactionData do // we'll ignore any data but Accepted, or error messages
      if copy(line,1,1)='Y' then
        TransactionStatus := tsAccept
      else if pos('TIME OUT',line)>0 then
        TransactionStatus := tsTimeOut
      else if pos('INVALID',line)>0 then
        TransactionStatus := tsInvalid
      else
        TransactionStatus := tsReject;
  finally
    free;
  end
end;

  // set buffer from the appropriate TransactionData fields
procedure TICVerifyTransactionQueuer.WriteDataToBuffer(var buffer: string);
begin
  with TransactionData do
    buffer :='"'+TransactionType+'",'+
             '"WQR",'+ // Web Queueing Robot as our "clerk"
             '"'+TransactionID+'",'+ // ID as our Comment
             '"'+CardNumber+'",'+
             '"'+ExpiryYear+ExpiryMonth+'",'+ // e.g. 9805
             '"'+TransactionAmount+'"'

// for example:
// "C1","WQR","Bill Jones","1234123412341234","9805","25.00"
end;

  // extract the appropriate TransactionData fields
procedure TICVerifyTransactionQueuer.ReadDataFromBuffer(const buffer: string);
begin
  fTransactionData.transactionStatus := tsQueue; // still queued, thanks
  // we won't bother reading the data because for ICVerify,
  // the contents of this file are unchanged, and hence
  // the original (and, we expect, currently-set) transaction
  // information should be correct
end;

procedure Register;
begin
  RegisterComponents('Compress', [TSimpleFileTransactionQueuer,TSimpleFileTransactionProcessor,TICVerifyTransactionQueuer]);
end;

end.